indVesaMode(xsize,ysize,24); END; IF mode = 0 THEN BEGIN WriteLn('No such mode could be found !'); WriteLn('Switching to to 320x200.'); ReadKey; mode := V320x200x256; END; END; begin { program body } SelectMode; Initialize; ReportStatus; { AspectRatioPlay; } FillEllipsePlay; SectorPlay; WriteModePlay; ColorPlay; { PalettePlay only intended to work on these drivers: } if (GraphDriver = EGA) or (GraphDriver = EGA64) or (GraphDriver = VGA) then PalettePlay; PutPixelPlay; { PutImagePlay; } RandBarPlay; BarPlay; Bar3DPlay; ArcPlay; CirclePlay; PiePlay; LineToPlay; LineRelPlay; { LineStylePlay; } { UserLineStylePlay; } TextDump; TextPlay; CrtModePlay; FillStylePlay; FillPatternPlay; PolyPlay; SayGoodbye; { CloseGraph; } CloseVesa; end. *************************************************** '* SHOW D2ROTATE (ABOUT THE ORIGIN) '****************************************************************c*#^v/:j0t+l""g?%H׫׽èU'թV? ujOEZ1! B8]1GlNqݲ;$zE<c*bE#Ϥ"Lrda a^1~)@M06DFvkpؐ)}1w3ρha[THqDKY-tTЧ.*I9l{c$oFr;O2eL4^N|ثO?FOz`'<>>$6 XgoGd߰?_9Lq'Oߟn43p.O}'O?t!8/pEVoxc5ȧ$?$ZspKX9\kO_5\A[јłNu16 g,%hccDVRKR;8آs㵠xgzPMy+Ji+3 ͥӌ^Grs %#(?%u86+Q)))Afw)B&4LXV:t@.;5ftJU8ǂpvg҂عI.^vZ& 66XNE kIA+҂bt-YauuvhuSvF;p(w@KHU RW 2M%.SNA1JEl]>\%4O&/)8vSP߲a4SP- ?䠸N*qU^I.rR&$Y^%BCeat Color := RandColor; SetColor(Color); SetFillStyle(Random(CloseDotFill)+1, Color); Bar3D(Random(MaxWidth), Random(MaxHeight), Random(MaxWidth), Random(MaxHeight), 0, TopOff); until KeyPressed; WaitToGo; end; { RandBarPlay } procedure ArcPlay; { Draw random arcs on the screen } var MaxRadius : word; EndAngle : word; ArcInfo : ArcCoordsType; begin MainWindow('Arc / GetArcCoords demonstration'); StatusLine('Esc aborts or press a key'); MaxRadius := MaxY div 10; repeat SetColor(RandColor); EndAngle := Random(360); SetLineStyle(SolidLn, 0, NormWidth); Arc(Random(MaxX), Random(MaxY), Random(EndAngle), EndAngle, Random(MaxRadius)); GetArcCoords(ArcInfo); with ArcInfo do begin Line(X, Y, XStart, YStart); Line(X, Y, Xend, Yend); end; until KeyPressed; WaitToGo; end; { ArcPlay } procedure PutPixelPlay; { Demonstrate the PutPixel and GetPixel commands } const Seed = 1962; { A seed for the random number generator } NumPts = 2000; { The number of pixels plotted } Esc = #27; var I : word; X, Y, Color : word; XMax, YMax : integer; ViewInfo : ViewPortType; begin MainWindow('PutPixel / GetPixel demonstration'); StatusLine('Esc aborts or press a key...'); GetViewSettings(ViewInfo); with ViewInfo do begin XMax := (x2-x1-1); YMax := (y2-y1-1); end; while not KeyPressed do begin { Plot random pixels } RandSeed := Seed; I := 0; while (not KeyPressed) and (I < NumPts) do begin Inc(I); PutPixel(Random(XMax)+1, Random(YMax)+1, RandColor); end; { Erase pixels } RandSeed := Seed; I := 0; while (not KeyPressed) and (I < NumPts) do begin Inc(I); X := Random(XMax)+1; Y := Random(YMax)+1; Color := GetPixel(X, Y); if Color = RandColor then PutPixel(X, Y, 0); end; end; WaitToGo; end; { PutPixelPlay } procedure PutImagePlay; { Demonstrate the GetImage and PutImage commands } const r = 20; StartX = 100; StartY = 50; var CurPort : ViewPortType; procedure MoveSaucer(var X, Y : integer; Width, Height : integer); var Step : integer; begin Step := Random(2*r); if Odd(Step) then Step := -Step; X := X + Step; Step := Random(r); if Odd(Step) then Step := -Step; Y := Y + Step; { Make saucer bounce off viewport walls } with CurPort do begin if (x1 + X + Width - 1 > x2) then X := x2-x1 - Width + 1 else if (X < 0) then X := 0; if (y1 + Y + Height - 1 > y2) then Y := y2-y1 - Height + 1 else if (Y < 0) then Y := 0; end; end; { MoveSaucer } var Pausetime : word; Saucer : pointer; X, Y : integer; ulx, uly : word; lrx, lry : word; Size : word; I : word; begin ClearDevice; FullPort; { PaintScreen } ClearDevice; MainWindow('GetImage / PutImage Demonstration'); StatusLine('Esc aborts or press a key...'); GetViewSettings(CurPort); { DrawSaucer } Ellipse(StartX, StartY, 0, 360, r, (r div 3)+2); Ellipse(StartX, StartY-4, 190, 357, r, r div 3); Line(StartX+7, StartY-6, StartX+10, StartY-12); Circle(StartX+10, StartY-12, 2); Line(StartX-7, StartY-6, StartX-10, StartY-12); Circle(StartX-10, StartY-12, 2); SetFillStyle(SolidFill, MaxColor); FloodFill(StartX+1, StartY+4, GetColor); { ReadSaucerImage } ulx := StartX-(r+1); uly := StartY-14; lrx := StartX+(r+1); lry := StartY+(r div 3)+3; Size := ImageSize(ulx, uly, lrx, lry); GetMem(Saucer, Size); GetImage(ulx, uly, lrx, lry, Saucer^); { PutImage(ulx, uly, Saucer^, XORput); { erase image } { Plot some "stars" } for I := 1 to 1000 do PutPixel(Random(MaxX), Random(MaxY), RandColor); X := MaxX div 2; Y := MaxY div 2; PauseTime := 70; { Move the saucer around } repeat { PutImage(X, Y, Saucer^, XORput); { draw image } Delay(PauseTime); { PutImage(X, Y, Saucer^, XORput); { erase image } MoveSaucer(X, Y, lrx - ulx + 1, lry - uly + 1); { width/height } until KeyPressed; FreeMem(Saucer, size); WaitToGo; end; { PutImagePlay } procedure PolyPlay; { Draw random polygons with random fill styles on the screen } const MaxPts = 5; type PolygonType = array[1..MaxPts] of PointType; var Poly : PolygonType; I, Color : word; begin MainWindow('FillPoly demonstration'); StatusLine('Esc aborts or press a key...'); repeat Color := RandColor; SetFillStyle(Random(11)+1, Color); SetColor(Color); for I := 1 to MaxPts do with Poly[I] do begin X := Random(MaxX); Y := Random(MaxY); end; FillPoly(MaxPts, Poly); until KeyPressed; WaitToGo; end; { PolyPlay } procedure FillStylePlay; { Display all of the predefined fill styles available } var Style : word; Width : word; Height : word; X, Y : word; I, J : word; ViewInfo : ViewPortType; procedure DrawBox(X, Y : word); begin SetFillStyle(Style, MaxColor); with ViewInfo do Bar(X, Y, X+Width, Y+Height); Rectangle(X, Y, X+Width, Y+Height); OutTextXY(X+(Width div 2), Y+Height+4, Int2Str(Style)); Inc(Style); end; { DrawBox } begin MainWindow('Pre-defined fill styles'); GetViewSettings(ViewInfo); with ViewInfo do begin Width := 2 * ((x2+1) div 13); Height := 2 * ((y2-10) div 10); end; X := Width div 2; Y := Height div 2; Style := 0; for J := 1 to 3 do begin for I := 1 to 4 do begin DrawBox(X, Y); Inc(X, (Width div 2) * 3); end; X := Width div 2; Inc(Y, (Height div 2) * 3); end; SetTextJustify(LeftText, TopText); WaitToGo; end; { FillStylePlay } procedure FillPatternPlay; { Display some user defined fill patterns } const Patterns : array[0..11] of FillPatternType = ( ($AA, $55, $AA, $55, $AA, $55, $AA, $55 !BBx!!!BBx!BBx"""DDp""DDp>"""BBp""!"BDp>I|   @>00>> $< @p> BBBB< @@****DDDDDDDUUUUUUUwwwwwww;DDD; $"Bd>@@@>||>Ac]AAA1N"A""2, `1NA"*III*>xDDxDNDD <` <>BB= > """>0@@A>@@@ b$(. b$(*  $ $ $DDDDDDDUUUUUUUwwwwwww7HH7"B\DBBRL~BB@@@@@@?R~!!~?DDDD8BBBB|@@>P>III>"AA""AAA"Uw > hH02L2L$$<H(,$<>>>>>>> VMODE=VIDEOMODEGET IF WHICHVGA = 0 THEN STOP DUMMY=RES640 SETVIEW 100, 100, 539, 379 FILLVIEW 10 WHILE INKEY$ = "" WEND VIDEOMODESET VMODE END 63 FONTGETINFO PROTOTYPE SUB FONTGETINFO (Width%, Height%) INPUT no input parameters WEND MOUSEEXIT VIDEOMODESET VMODE END 86 MOUSECURSORDEFAULT PROTOTYPE SUB MOUSECURSORDEFAULT () INPUT no input parameters OUTPUT no value returned USAGE MOUSECURSORDEFAULT defines the mouse cursor to be a small ,K$ѰXQ)崔ĴT,ԪX9\9U`94ad9UTah9tal9Uap9ԴatPTx0೏Uൗඛ෣p⸭ sKb<$݉   I1 E $Y풉 (m , 0$ I 풉 4 ! $5 I ] 8q @5+Ӑ$@ #@ $ #@4,p&e_Q4 Q @;_Q@e@mp!aO`PT8!$"qPCҰeT" '1' THEN BEGIN WriteLn('Sorry !'); WriteLn('This demo wasn''t written for more as 256 colors !'); WriteLn('You would only get a limited impression of the Hi-& TrueColor modes...'); WriteLn('Switching to 256 colors.'); choice1 := '1'; END; UNTIL choice1 IN ['1'..'4','q']; IF choice1 = 'q' THEN Halt; WriteLn; WriteLn; WriteLn('a. 320x200'); WriteLn('b. 640x480'); WriteLn('c. 800x600'); WriteLn('d. 1024x768'); WriteLn('e. 1280x1024'); WriteLn('Q uit'); WriteLn; Write('Your choice: '); REPEAT ReadLn(choice2); UNTIL choice2 IN ['a'..'e','q']; IF choice2 = 'q' THEN Halt; CASE choice2 OF 'a' : BEGIN xsize := 320; ysize := 200; END; 'b' : BEGIN xsize := 640; ysize := 480; END; 'c' : BEGIN xsize := 800; ysize := 600; END; 'd' : BEGIN xsize := 1024; ysize := 768; END; 'e' : BEGIN xsize := 1280; ysize := 1024; END; END; CASE choice1 OF '1' : mode := FindVesaMode(xsize,ysize,8); '2' : mode := FindVesaMode(xsize,ysize,15); '3' : mode := FindVesaMode(xsize,ysize,16); '4' : mode := FindVesaMode(xsize,ysize,24); END; IF mode = 0 THEN BEGIN WriteLn('No such mode could be found !'); WriteLn('Switching to to 320x200.'); ReadKey; mode := V320x200x256; END; END; begin { program body } SelectMode; Initialize; ReportStatus; { AspectRatioPlay; } FillEllipsePlay; SectorPlay; WriteModePlay; ColorPlay; { PalettePlay only intended to work on these drivers: } if (GraphDriver = EGA) or (GraphDriver = EGA64) or (GraphDriver = VGA) then PalettePlay; PutPixelPlay; { PutImagePlay; } RandBarPlay; BarPlay; Bar3DPlay; ArcPlay; CirclePlay; PiePlay; LineToPlay; LineRelPlay; { LineStylePlay; } { UserLineStylePlay; } TextDump; TextPlay; CrtModePlay; FillStylePlay; FillPatternPlay; PolyPlay; SayGoodbye; { CloseGraph; } CloseVesa; end. *************************************************** '* SHOW D2ROTATE (ABOUT THE ORIGIN) '****************************************************************c*#^v/:j0t+l""g?%H׫׽èU'թV? ujOEZ1! B8]1GlNqݲ;$zE<c*bE#Ϥ"Lrda a^1~)@M06DFvkpؐ)}1w3ρha[THqDKY-tTЧ.*I9l{c$oFr;O2eL4^N|ثO?FOz`'<>>$6 XgoGd߰?_9Lq'Oߟn43p.O}'O?t!8/pEVoxc5ȧ$?$ZspKX9\kO_5\A[јłNu16 g,%hccDVRKR;8آs㵠xgzPMy+Ji+3 ͥӌ^Grs %#(?%u86+Q)))Afw)B&4LXV:t@.;5ftJU8ǂpvg҂عI.^vZ& 66XNE kIA+҂bt-YauuvhuSvF;p(w@KHU RW 2M%.SNA1JEl]>\%4O&/)8vSP߲a4SP- ?䠸N*qU^I.rR&$Y^%BCeat Color := RandColor; SetColor(Color); SetFillStyle(Random(CloseDotFill)+1, Color); Bar3D(Random(MaxWidth), Random(MaxHeight), Random(MaxWidth), Random(MaxHeight), 0, TopOff); until KeyPressed; WaitToGo; end; { RandBarPlay } procedure ArcPlay; { Draw random arcs on the screen } var MaxRadius : word; EndAngle : word; ArcInfo : ArcCoordsType; begin MainWindow('Arc / GetArcCoords demonstration'); StatusLine('Esc aborts or press a key'); MaxRadius := MaxY div 10; repeat SetColor(RandColor); EndAngle := Random(360); SetLineStyle(SolidLn, 0, NormWidth); Arc(Random(MaxX), Random(MaxY), Random(EndAngle), EndAngle, Random(MaxRadius)); GetArcCoords(ArcInfo); with ArcInfo do begin Line(X, Y, XStart, YStart); Line(X, Y, Xend, Yend); end; until KeyPressed; WaitToGo; end; { ArcPlay } procedure PutPixelPlay; { Demonstrate the PutPixel and GetPixel commands } const Seed = 1962; { A seed for the random number generator } NumPts = 2000; { The number of pixels plotted } Esc = #27; var I : word; X, Y, Color : word; XMax, YMax : integer; ViewInfo : ViewPortType; begin MainWindow('PutPixel / GetPixel demonstration'); StatusLine('Esc aborts or press a key...'); GetViewSettings(ViewInfo); with ViewInfo do begin XMax := (x2-x1-1); YMax := (y2-y1-1); end; while not KeyPressed do begin { Plot random pixels } RandSeed := Seed; I := 0; while (not KeyPressed) and (I < NumPts) do begin Inc(I); PutPixel(Random(XMax)+1, Random(YMax)+1, RandColor); end; { Erase pixels } RandSeed := Seed; I := 0; while (not KeyPressed) and (I < NumPts) do begin Inc(I); X := Random(XMax)+1; Y := Random(YMax)+1; Color := GetPixel(X, Y); if Color = RandColor then PutPixel(X, Y, 0); end; end; WaitToGo; end; { PutPixelPlay } procedure PutImagePlay; { Demonstrate the GetImage and PutImage commands } const r = 20; StartX = 100; StartY = 50; var CurPort : ViewPortType; procedure MoveSaucer(var X, Y : integer; Width, Height : integer); var Step : integer; begin Step := Random(2*r); if Odd(Step) then Step := -Step; X := X + Step; Step := Random(r); if Odd(Step) then Step := -Step; Y := Y + Step; { Make saucer bounce off viewport walls } with CurPort do begin if (x1 + X + Width - 1 > x2) then X := x2-x1 - Width + 1 else if (X < 0) then X := 0; if (y1 + Y + Height - 1 > y2) then Y := y2-y1 - Height + 1 else if (Y < 0) then Y := 0; end; end; { MoveSaucer } var Pausetime : word; Saucer : pointer; X, Y : integer; ulx, uly : word; lrx, lry : word; Size : word; I : word; begin ClearDevice; FullPort; { PaintScreen } ClearDevice; MainWindow('GetImage / PutImage Demonstration'); StatusLine('Esc aborts or press a key...'); GetViewSettings(CurPort); { DrawSaucer } Ellipse(StartX, StartY, 0, 360, r, (r div 3)+2); Ellipse(StartX, StartY-4, 190, 357, r, r div 3); Line(StartX+7, StartY-6, StartX+10, StartY-12); Circle(StartX+10, StartY-12, 2); Line(StartX-7, StartY-6, StartX-10, StartY-12); Circle(StartX-10, StartY-12, 2); SetFillStyle(SolidFill, MaxColor); FloodFill(StartX+1, StartY+4, GetColor); { ReadSaucerImage } ulx := StartX-(r+1); uly := StartY-14; lrx := StartX+(r+1); lry := StartY+(r div 3)+3; Size := ImageSize(ulx, uly, lrx, lry); GetMem(Saucer, Size); GetImage(ulx, uly, lrx, lry, Saucer^); { PutImage(ulx, uly, Saucer^, XORput); { erase image } { Plot some "stars" } for I := 1 to 1000 do PutPixel(Random(MaxX), Random(MaxY), RandColor); X := MaxX div 2; Y := MaxY div 2; PauseTime := 70; { Move the saucer around } repeat { PutImage(X, Y, Saucer^, XORput); { draw image } Delay(PauseTime); { PutImage(X, Y, Saucer^, XORput); { erase image } MoveSaucer(X, Y, lrx - ulx + 1, lry - uly + 1); { width/height } until KeyPressed; FreeMem(Saucer, size); WaitToGo; end; { PutImagePlay } procedure PolyPlay; { Draw random polygons with random fill styles on the screen } const MaxPts = 5; type PolygonType = array[1..MaxPts] of PointType; var Poly : PolygonType; I, Color : word; begin MainWindow('FillPoly demonstration'); StatusLine('Esc aborts or press a key...'); repeat Color := RandColor; SetFillStyle(Random(11)+1, Color); SetColor(Color); for I := 1 to MaxPts do with Poly[I] do begin X := Random(MaxX); Y := Random(MaxY); end; FillPoly(MaxPts, Poly); until KeyPressed; WaitToGo; end; { PolyPlay } procedure FillStylePlay; { Display all of the predefined fill styles available } var Style : word; Width : word; Height : word; X, Y : word; I, J : word; ViewInfo : ViewPortType; procedure DrawBox(X, Y : word); begin SetFillStyle(Style, MaxColor); with ViewInfo do Bar(X, Y, X+Width, Y+Height); Rectangle(X, Y, X+Width, Y+Height); OutTextXY(X+(Width div 2), Y+Height+4, Int2Str(Style)); Inc(Style); end; { DrawBox } begin MainWindow('Pre-defined fill styles'); GetViewSettings(ViewInfo); with ViewInfo do begin Width := 2 * ((x2+1) div 13); Height := 2 * ((y2-10) div 10); end; X := Width div 2; Y := Height div 2; Style := 0; for J := 1 to 3 do begin for I := 1 to 4 do begin DrawBox(X, Y); Inc(X, (Width div 2) * 3); end; X := Width div 2; Inc(Y, (Height div 2) * 3); end; SetTextJustify(LeftText, TopText); WaitToGo; end; { FillStylePlay } procedure FillPatternPlay; { Display some user defined fill patterns } const Patterns : array[0..11] of FillPatternType = ( ($AA, $55, $AA, $55, $AA, $55, $AA, $55 !BBx!!!BBx!BBx"""DDp""DDp>"""BBp""!"BDp>I|   @>00>> $< @p> BBBB< @@****DDDDDDDUUUUUUUwwwwwww;DDD; $"Bd>@@@>||>Ac]AAA1N"A""2, `1NA"*III*>xDDxDNDD <` <>BB= > """>0@@A>@@@ b$(. b$(*  $ $ $DDDDDDDUUUUUUUwwwwwww7HH7"B\DBBRL~BB@@@@@@?R~!!~?DDDD8BBBB|@@>P>III>"AA""AAA"Uw > hH02L2L$$<H(,$<>>>>>>> VMODE=VIDEOMODEGET IF WHICHVGA = 0 THEN STOP DUMMY=RES640 SETVIEW 100, 100, 539, 379 FILLVIEW 10 WHILE INKEY$ = "" WEND VIDEOMODESET VMODE END 63 FONTGETINFO PROTOTYPE SUB FONTGETINFO (Width%, Height%) INPUT no input parameters WEND MOUSEEXIT VIDEOMODESET VMODE END 86 MOUSECURSORDEFAULT PROTOTYPE SUB MOUSECURSORDEFAULT () INPUT no input parameters OUTPUT no value returned USAGE MOUSECURSORDEFAULT defines the mouse cursor to be a small ,K$ѰXQ)崔ĴT,ԪX9\9U`94ad9UTah9tal9Uap9ԴatPTx0೏Uൗඛ෣p⸭ sKb<$݉   I1 E $Y풉 (m , 0$ I 풉 4 ! $5 I ] 8q @5+Ӑ$@ #@ $ #@4,p&e_Q4 Q @;_Q@e@mp!aO`PT8!$"qPCҰeT" '1' THEN BEGIN WriteLn('Sorry !'); WriteLn('This demo wasn''t written for more as 256 colors !'); WriteLn('You would only get a limited impression of the Hi-& TrueColor modes...'); WriteLn('Switching to 256 colors.'); choice1 := '1'; END; UNTIL choice1 IN ['1'..'4','q']; IF choice1 = 'q' THEN Halt; WriteLn; WriteLn; WriteLn('a. 320x200'); WriteLn('b. 640x480'); WriteLn('c. 800x600'); WriteLn('d. 1024x768'); WriteLn('e. 1280x1024'); WriteLn('Q uit'); WriteLn; Write('Your choice: '); REPEAT ReadLn(choice2); UNTIL choice2 IN ['a'..'e','q']; IF choice2 = 'q' THEN Halt; CASE choice2 OF 'a' : BEGIN xsize := 320; ysize := 200; END; 'b' : BEGIN xsize := 640; ysize := 480; END; 'c' : BEGIN xsize := 800; ysize := 600; END; 'd' : BEGIN xsize := 1024; ysize := 768; END; 'e' : BEGIN xsize := 1280; ysize := 1024; END; END; CASE choice1 OF '1' : mode := FindVesaMode(xsize,ysize,8); '2' : mode := FindVesaMode(xsize,ysize,15); '3' : mode := FindVesaMode(xsize,ysize,16); '4' : mode := FindVesaMode(xsize,ysize,24); END; IF mode = 0 THEN BEGIN WriteLn('No such mode could be found !'); WriteLn('Switching to to 320x200.'); ReadKey; mode := V320x200x256; END; END; begin { program body } SelectMode; Initialize; ReportStatus; { AspectRatioPlay; } FillEllipsePlay; SectorPlay; WriteModePlay; ColorPlay; { PalettePlay only intended to work on these drivers: } if (GraphDriver = EGA) or (GraphDriver = EGA64) or (GraphDriver = VGA) then PalettePlay; PutPixelPlay; { PutImagePlay; } RandBarPlay; BarPlay; Bar3DPlay; ArcPlay; CirclePlay; PiePlay; LineToPlay; LineRelPlay; { LineStylePlay; } { UserLineStylePlay; } TextDump; TextPlay; CrtModePlay; FillStylePlay; FillPatternPlay; PolyPlay; SayGoodbye; { CloseGraph; } CloseVesa; end. *************************************************** '* SHOW D2ROTATE (ABOUT THE ORIGIN) '****************************************************************c*#^v/:j0t+l""g?%H׫׽èU'թV? ujOEZ1! B8]1GlNqݲ;$zE<c*bE#Ϥ"Lrda a^1~)@M06DFvkpؐ)}1w3ρha[THqDKY-tTЧ.*I9l{c$oFr;O2eL4^N|ثO?FOz`'<>>$6 XgoGd߰?_9Lq'Oߟn43p.O}'O?t!8/pEVoxc5ȧ$?$ZspKX9\kO_5\A[јłNu16 g,%hccDVRKR;8آs㵠xgzPMy+Ji+3 ͥӌ^Grs %#(?%u86+Q)))Afw)B&4LXV:t@.;5ftJU8ǂpvg҂عI.^vZ& 66XNE kIA+҂bt-YauuvhuSvF;p(w@KHU RW 2M%.SNA1JEl]>\%4O&/)8vSP߲a4SP- ?䠸N*qU^I.rR&$Y^%BCeat Color := RandColor; SetColor(Color); SetFillStyle(Random(CloseDotFill)+1, Color); Bar3D(Random(MaxWidth), Random(MaxHeight), Random(MaxWidth), Random(MaxHeight), 0, TopOff); until KeyPressed; WaitToGo; end; { RandBarPlay } procedure ArcPlay; { Draw random arcs on the screen } var MaxRadius : word; EndAngle : word; ArcInfo : ArcCoordsType; begin MainWindow('Arc / GetArcCoords demonstration'); StatusLine('Esc aborts or press a key'); MaxRadius := MaxY div 10; repeat SetColor(RandColor); EndAngle := Random(360); SetLineStyle(SolidLn, 0, NormWidth); Arc(Random(MaxX), Random(MaxY), Random(EndAngle), EndAngle, Random(MaxRadius)); GetArcCoords(ArcInfo); with ArcInfo do begin Line(X, Y, XStart, YStart); Line(X, Y, Xend, Yend); end; until KeyPressed; WaitToGo; end; { ArcPlay } procedure PutPixelPlay; { Demonstrate the PutPixel and GetPixel commands } const Seed = 1962; { A seed for the random number generator } NumPts = 2000; { The number of pixels plotted } Esc = #27; var I : word; X, Y, Color : word; XMax, YMax : integer; ViewInfo : ViewPortType; begin MainWindow('PutPixel / GetPixel demonstration'); StatusLine('Esc aborts or press a key...'); GetViewSettings(ViewInfo); with ViewInfo do begin XMax := (x2-x1-1); YMax := (y2-y1-1); end; while not KeyPressed do begin { Plot random pixels } RandSeed := Seed; I := 0; while (not KeyPressed) and (I < NumPts) do begin Inc(I); PutPixel(Random(XMax)+1, Random(YMax)+1, RandColor); end; { Erase pixels } RandSeed := Seed; I := 0; while (not KeyPressed) and (I < NumPts) do begin Inc(I); X := Random(XMax)+1; Y := Random(YMax)+1; Color := GetPixel(X, Y); if Color = RandColor then PutPixel(X, Y, 0); end; end; WaitToGo; end; { PutPixelPlay } procedure PutImagePlay; { Demonstrate the GetImage and PutImage commands } const r = 20; StartX = 100; StartY = 50; var CurPort : ViewPortType; procedure MoveSaucer(var X, Y : integer; Width, Height : integer); var Step : integer; begin Step := Random(2*r); if Odd(Step) then Step := -Step; X := X + Step; Step := Random(r); if Odd(Step) then Step := -Step; Y := Y + Step; { Make saucer bounce off viewport walls } with CurPort do begin if (x1 + X + Width - 1 > x2) then X := x2-x1 - Width + 1 else if (X < 0) then X := 0; if (y1 + Y + Height - 1 > y2) then Y := y2-y1 - Height + 1 else if (Y < 0) then Y := 0; end; end; { MoveSaucer } var Pausetime : word; Saucer : pointer; X, Y : integer; ulx, uly : word; lrx, lry : word; Size : word; I : word; begin ClearDevice; FullPort; { PaintScreen } ClearDevice; MainWindow('GetImage / PutImage Demonstration'); StatusLine('Esc aborts or press a key...'); GetViewSettings(CurPort); { DrawSaucer } Ellipse(StartX, StartY, 0, 360, r, (r div 3)+2); Ellipse(StartX, StartY-4, 190, 357, r, r div 3); Line(StartX+7, StartY-6, StartX+10, StartY-12); Circle(StartX+10, StartY-12, 2); Line(StartX-7, StartY-6, StartX-10, StartY-12); Circle(StartX-10, StartY-12, 2); SetFillStyle(SolidFill, MaxColor); FloodFill(StartX+1, StartY+4, GetColor); { ReadSaucerImage } ulx := StartX-(r+1); uly := StartY-14; lrx := StartX+(r+1); lry := StartY+(r div 3)+3; Size := ImageSize(ulx, uly, lrx, lry); GetMem(Saucer, Size); GetImage(ulx, uly, lrx, lry, Saucer^); { PutImage(ulx, uly, Saucer^, XORput); { erase image } { Plot some "stars" } for I := 1 to 1000 do PutPixel(Random(MaxX), Random(MaxY), RandColor); X := MaxX div 2; Y := MaxY div 2; PauseTime := 70; { Move the saucer around } repeat { PutImage(X, Y, Saucer^, XORput); { draw image } Delay(PauseTime); { PutImage(X, Y, Saucer^, XORput); { erase image } MoveSaucer(X, Y, lrx - ulx + 1, lry - uly + 1); { width/height } until KeyPressed; FreeMem(Saucer, size); WaitToGo; end; { PutImagePlay } procedure PolyPlay; { Draw random polygons with random fill styles on the screen } const MaxPts = 5; type PolygonType = array[1..MaxPts] of PointType; var Poly : PolygonType; I, Color : word; begin MainWindow('FillPoly demonstration'); StatusLine('Esc aborts or press a key...'); repeat Color := RandColor; SetFillStyle(Random(11)+1, Color); SetColor(Color); for I := 1 to MaxPts do with Poly[I] do begin X := Random(MaxX); Y := Random(MaxY); end; FillPoly(MaxPts, Poly); until KeyPressed; WaitToGo; end; { PolyPlay } procedure FillStylePlay; { Display all of the predefined fill styles available } var Style : word; Width : word; Height : word; X, Y : word; I, J : word; ViewInfo : ViewPortType; procedure DrawBox(X, Y : word); begin SetFillStyle(Style, MaxColor); with ViewInfo do Bar(X, Y, X+Width, Y+Height); Rectangle(X, Y, X+Width, Y+Height); OutTextXY(X+(Width div 2), Y+Height+4, Int2Str(Style)); Inc(Style); end; { DrawBox } begin MainWindow('Pre-defined fill styles'); GetViewSettings(ViewInfo); with ViewInfo do begin Width := 2 * ((x2+1) div 13); Height := 2 * ((y2-10) div 10); end; X := Width div 2; Y := Height div 2; Style := 0; for J := 1 to 3 do begin for I := 1 to 4 do begin DrawBox(X, Y); Inc(X, (Width div 2) * 3); end; X := Width div 2; Inc(Y, (Height div 2) * 3); end; SetTextJustify(LeftText, TopText); WaitToGo; end; { FillStylePlay } procedure FillPatternPlay; { Display some user defined fill patterns } const Patterns : array[0..11] of FillPatternType = ( ($AA, $55, $AA, $55, $AA, $55, $AA, $55 !BBx!!!BBx!BBx"""DDp""DDp>"""BBp""!"BDp>I|   @>00>> $< @p> BBBB< @@****DDDDDDDUUUUUUUwwwwwww;DDD; $"Bd>@@@>||>Ac]AAA1N"A""2, `1NA"*III*>xDDxDNDD <` <>BB= > """>0@@A>@@@ b$(. b$(*  $ $ $DDDDDDDUUUUUUUwwwwwww7HH7"B\DBBRL~BB@@@@@@?R~!!~?DDDD8BBBB|@@>P>III>"AA""AAA"Uw > hH02L2L$$<H(,$<>>>>>>> VMODE=VIDEOMODEGET IF WHICHVGA = 0 THEN STOP DUMMY=RES640 SETVIEW 100, 100, 539, 379 FILLVIEW 10 WHILE INKEY$ = "" WEND VIDEOMODESET VMODE END 63 FONTGETINFO PROTOTYPE SUB FONTGETINFO (Width%, Height%) INPUT no input parameters WEND MOUSEEXIT VIDEOMODESET VMODE END 86 MOUSECURSORDEFAULT PROTOTYPE SUB MOUSECURSORDEFAULT () INPUT no input parameters OUTPUT no value returned USAGE MOUSECURSORDEFAULT defines the mouse cursor to be a small ,K$ѰXQ)崔ĴT,ԪX9\9U`94ad9UTah9tal9Uap9ԴatPTx0೏Uൗඛ෣p⸭ sKb<$݉   I1 E $Y풉 (m , 0$ I 풉 4 ! $5 I ] 8q @5+Ӑ$@ #@ $ #@4,p&e_Q4 Q @;_Q@e@mp!aO`PT8!$"qPCҰeT" '1' THEN BEGIN WriteLn('Sorry !'); WriteLn('This demo wasn''t written for more as 256 colors !'); WriteLn('You would only get a limited impression of the Hi-& TrueColor modes...'); WriteLn('Switching to 256 colors.'); choice1 := '1'; END; UNTIL choice1 IN ['1'..'4','q']; IF choice1 = 'q' THEN Halt; WriteLn; WriteLn; WriteLn('a. 320x200'); WriteLn('b. 640x480'); WriteLn('c. 800x600'); WriteLn('d. 1024x768'); WriteLn('e. 1280x1024'); WriteLn('Q uit'); WriteLn; Write('Your choice: '); REPEAT ReadLn(choice2); UNTIL choice2 IN ['a'..'e','q']; IF choice2 = 'q' THEN Halt; CASE choice2 OF 'a' : BEGIN xsize := 320; ysize := 200; END; 'b' : BEGIN xsize := 640; ysize := 480; END; 'c' : BEGIN xsize := 800; ysize := 600; END; 'd' : BEGIN xsize := 1024; ysize := 768; END; 'e' : BEGIN xsize := 1280; ysize := 1024; END; END; CASE choice1 OF '1' : mode := FindVesaMode(xsize,ysize,8); '2' : mode := FindVesaMode(xsize,ysize,15); '3' : mode := FindVesaMode(xsize,ysize,16); '4' : mode := FindVesaMode(xsize,ysize,24); END; IF mode = 0 THEN BEGIN WriteLn('No such mode could be found !'); WriteLn('Switching to to 320x200.'); ReadKey; mode := V320x200x256; END; END; begin { program body } SelectMode; Initialize; ReportStatus; { AspectRatioPlay; } FillEllipsePlay; SectorPlay; WriteModePlay; ColorPlay; { PalettePlay only intended to work on these drivers: } if (GraphDriver = EGA) or (GraphDriver = EGA64) or (GraphDriver = VGA) then PalettePlay; PutPixelPlay; { PutImagePlay; } RandBarPlay; BarPlay; Bar3DPlay; ArcPlay; CirclePlay; PiePlay; LineToPlay; LineRelPlay; { LineStylePlay; } { UserLineStylePlay; } TextDump; TextPlay; CrtModePlay; FillStylePlay; FillPatternPlay; PolyPlay; SayGoodbye; { CloseGraph; } CloseVesa; end. *************************************************** '* SHOW D2ROTATE (ABOUT THE ORIGIN) '****************************************************************c*#^v/:j0t+l""g?%H׫׽èU'թV? ujOEZ1! B8]1GlNqݲ;$zE<c*bE#Ϥ"Lrda a^1~)@M06DFvkpؐ)}1w3ρha[THqDKY-tTЧ.*I9l{c$oFr;O2eL4^N|ثO?FOz`'<>>$6 XgoGd߰?_9Lq'Oߟn43p.O}'O?t!8/pEVoxc5ȧ$?$ZspKX9\kO_5\A[јłNu16 g,%hccDVRKR;8آs㵠xgzPMy+Ji+3 ͥӌ^Grs %#(?%u86+Q)))Afw)B&4LXV:t@.;5ftJU8ǂpvg҂عI.^vZ& 66XNE kIA+҂bt-YauuvhuSvF;p(w@KHU RW 2M%.SNA1JEl]>\%4O&/)8vSP߲a4SP- ?䠸N*qU^I.rR&$Y^%BCeat Color := RandColor; SetColor(Color); SetFillStyle(Random(CloseDotFill)+1, Color); Bar3D(Random(MaxWidth), Random(MaxHeight), Random(MaxWidth), Random(MaxHeight), 0, TopOff); until KeyPressed; WaitToGo; end; { RandBarPlay } procedure ArcPlay; { Draw random arcs on the screen } var MaxRadius : word; EndAngle : word; ArcInfo : ArcCoordsType; begin MainWindow('Arc / GetArcCoords demonstration'); StatusLine('Esc aborts or press a key'); MaxRadius := MaxY div 10; repeat SetColor(RandColor); EndAngle := Random(360); SetLineStyle(SolidLn, 0, NormWidth); Arc(Random(MaxX), Random(MaxY), Random(EndAngle), EndAngle, Random(MaxRadius)); GetArcCoords(ArcInfo); with ArcInfo do begin Line(X, Y, XStart, YStart); Line(X, Y, Xend, Yend); end; until KeyPressed; WaitToGo; end; { ArcPlay } procedure PutPixelPlay; { Demonstrate the PutPixel and GetPixel commands } const Seed = 1962; { A seed for the random number generator } NumPts = 2000; { The number of pixels plotted } Esc = #27; var I : word; X, Y, Color : word; XMax, YMax : integer; ViewInfo : ViewPortType; begin MainWindow('PutPixel / GetPixel demonstration'); StatusLine('Esc aborts or press a key...'); GetViewSettings(ViewInfo); with ViewInfo do begin XMax := (x2-x1-1); YMax := (y2-y1-1); end; while not KeyPressed do begin { Plot random pixels } RandSeed := Seed; I := 0; while (not KeyPressed) and (I < NumPts) do begin Inc(I); PutPixel(Random(XMax)+1, Random(YMax)+1, RandColor); end; { Erase pixels } RandSeed := Seed; I := 0; while (not KeyPressed) and (I < NumPts) do begin Inc(I); X := Random(XMax)+1; Y := Random(YMax)+1; Color := GetPixel(X, Y); if Color = RandColor then PutPixel(X, Y, 0); end; end; WaitToGo; end; { PutPixelPlay } procedure PutImagePlay; { Demonstrate the GetImage and PutImage commands } const r = 20; StartX = 100; StartY = 50; var CurPort : ViewPortType; procedure MoveSaucer(var X, Y : integer; Width, Height : integer); var Step : integer; begin Step := Random(2*r); if Odd(Step) then Step := -Step; X := X + Step; Step := Random(r); if Odd(Step) then Step := -Step; Y := Y + Step; { Make saucer bounce off viewport walls } with CurPort do begin if (x1 + X + Width - 1 > x2) then X := x2-x1 - Width + 1 else if (X < 0) then X := 0; if (y1 + Y + Height - 1 > y2) then Y := y2-y1 - Height + 1 else if (Y < 0) then Y := 0; end; end; { MoveSaucer } var Pausetime : word; Saucer : pointer; X, Y : integer; ulx, uly : word; lrx, lry : word; Size : word; I : word; begin ClearDevice; FullPort; { PaintScreen } ClearDevice; MainWindow('GetImage / PutImage Demonstration'); StatusLine('Esc aborts or press a key...'); GetViewSettings(CurPort); { DrawSaucer } Ellipse(StartX, StartY, 0, 360, r, (r div 3)+2); Ellipse(StartX, StartY-4, 190, 357, r, r div 3); Line(StartX+7, StartY-6, StartX+10, StartY-12); Circle(StartX+10, StartY-12, 2); Line(StartX-7, StartY-6, StartX-10, StartY-12); Circle(StartX-10, StartY-12, 2); SetFillStyle(SolidFill, MaxColor); FloodFill(StartX+1, StartY+4, GetColor); { ReadSaucerImage } ulx := StartX-(r+1); uly := StartY-14; lrx := StartX+(r+1); lry := StartY+(r div 3)+3; Size := ImageSize(ulx, uly, lrx, lry); GetMem(Saucer, Size); GetImage(ulx, uly, lrx, lry, Saucer^); { PutImage(ulx, uly, Saucer^, XORput); { erase image } { Plot some "stars" } for I := 1 to 1000 do PutPixel(Random(MaxX), Random(MaxY), RandColor); X := MaxX div 2; Y := MaxY div 2; PauseTime := 70; { Move the saucer around } repeat { PutImage(X, Y, Saucer^, XORput); { draw image } Delay(PauseTime); { PutImage(X, Y, Saucer^, XORput); { erase image } MoveSaucer(X, Y, lrx - ulx + 1, lry - uly + 1); { width/height } until KeyPressed; FreeMem(Saucer, size); WaitToGo; end; { PutImagePlay } procedure PolyPlay; { Draw random polygons with random fill styles on the screen } const MaxPts = 5; type PolygonType = array[1..MaxPts] of PointType; var Poly : PolygonType; I, Color : word; begin MainWindow('FillPoly demonstration'); StatusLine('Esc aborts or press a key...'); repeat Color := RandColor; SetFillStyle(Random(11)+1, Color); SetColor(Color); for I := 1 to MaxPts do with Poly[I] do begin X := Random(MaxX); Y := Random(MaxY); end; FillPoly(MaxPts, Poly); until KeyPressed; WaitToGo; end; { PolyPlay } procedure FillStylePlay; { Display all of the predefined fill styles available } var Style : word; Width : word; Height : word; X, Y : word; I, J : word; ViewInfo : ViewPortType; procedure DrawBox(X, Y : word); begin SetFillStyle(Style, MaxColor); with ViewInfo do Bar(X, Y, X+Width, Y+Height); Rectangle(X, Y, X+Width, Y+Height); OutTextXY(X+(Width div 2), Y+Height+4, Int2Str(Style)); Inc(Style); end; { DrawBox } begin MainWindow('Pre-defined fill styles'); GetViewSettings(ViewInfo); with ViewInfo do begin Width := 2 * ((x2+1) div 13); Height := 2 * ((y2-10) div 10); end; X := Width div 2; Y := Height div 2; Style := 0; for J := 1 to 3 do begin for I := 1 to 4 do begin DrawBox(X, Y); Inc(X, (Width div 2) * 3); end; X := Width div 2; Inc(Y, (Height div 2) * 3); end; SetTextJustify(LeftText, TopText); WaitToGo; end; { FillStylePlay } procedure FillPatternPlay; { Display some user defined fill patterns } const Patterns : array[0..11] of FillPatternType = ( ($AA, $55, $AA, $55, $AA, $55, $AA, $55 !BBx!!!BBx!BBx"""DDp""DDp>"""BBp""!"BDp>I|   @>00>> $< @p> BBBB< @@****DDDDDDDUUUUUUUwwwwwww;DDD; $"Bd>@@@>||>Ac]AAA1N"A""2, `1NA"*III*>xDDxDNDD <` <>BB= > """>0@@A>@@@ b$(. b$(*  $ $ $DDDDDDDUUUUUUUwwwwwww7HH7"B\DBBRL~BB@@@@@@?R~!!~?DDDD8BBBB|@@>P>III>"AA""AAA"Uw > hH02L2L$$<H(,$<>>>>>>> VMODE=VIDEOMODEGET IF WHICHVGA = 0 THEN STOP DUMMY=RES640 SETVIEW 100, 100, 539, 379 FILLVIEW 10 WHILE INKEY$ = "" WEND VIDEOMODESET VMODE END 63 FONTGETINFO PROTOTYPE SUB FONTGETINFO (Width%, Height%) INPUT no input parameters WEND MOUSEEXIT VIDEOMODESET VMODE END 86 MOUSECURSORDEFAULT PROTOTYPE SUB MOUSECURSORDEFAULT () INPUT no input parameters OUTPUT no value returned USAGE MOUSECURSORDEFAULT defines the mouse cursor to be a small ,K$ѰXQ)崔ĴT,ԪX9\9U`94ad9UTah9tal9Uap9ԴatPTx0೏Uൗඛ෣p⸭ sKb<$݉   I1 E $Y풉 (m , 0$ I 풉 4 ! $5 I ] 8q @5+Ӑ$@ #@ $ #@4,p&e_Q4 Q @;_Q@e@mp!aO`PT8!$"qPCҰeT" '1' THEN BEGIN WriteLn('Sorry !'); WriteLn('This demo wasn''t written for more as 256 colors !'); WriteLn('You would only get a limited impression of the Hi-& TrueColor modes...'); WriteLn('Switching to 256 colors.'); choice1 := '1'; END; UNTIL choice1 IN ['1'..'4','q']; IF choice1 = 'q' THEN Halt; WriteLn; WriteLn; WriteLn('a. 320x200'); WriteLn('b. 640x480'); WriteLn('c. 800x600'); WriteLn('d. 1024x768'); WriteLn('e. 1280x1024'); WriteLn('Q uit'); WriteLn; Write('Your choice: '); REPEAT ReadLn(choice2); UNTIL choice2 IN ['a'..'e','q']; IF choice2 = 'q' THEN Halt; CASE choice2 OF 'a' : BEGIN xsize := 320; ysize := 200; END; 'b' : BEGIN xsize := 640; ysize := 480; END; 'c' : BEGIN xsize := 800; ysize := 600; END; 'd' : BEGIN xsize := 1024; ysize := 768; END; 'e' : BEGIN xsize := 1280; ysize := 1024; END; END; CASE choice1 OF '1' : mode := FindVesaMode(xsize,ysize,8); '2' : mode := FindVesaMode(xsize,ysize,15); '3' : mode := FindVesaMode(xsize,ysize,16); '4' : mode := FindVesaMode(xsize,ysize,24); END; IF mode = 0 THEN BEGIN WriteLn('No such mode could be found !'); WriteLn('Switching to to 320x200.'); ReadKey; mode := V320x200x256; END; END; begin { program body } SelectMode; Initialize; ReportStatus; { AspectRatioPlay; } FillEllipsePlay; SectorPlay; WriteModePlay; ColorPlay; { PalettePlay only intended to work on these drivers: } if (GraphDriver = EGA) or (GraphDriver = EGA64) or (GraphDriver = VGA) then PalettePlay; PutPixelPlay; { PutImagePlay; } RandBarPlay; BarPlay; Bar3DPlay; ArcPlay; CirclePlay; PiePlay; LineToPlay; LineRelPlay; { LineStylePlay; } { UserLineStylePlay; } TextDump; TextPlay; CrtModePlay; FillStylePlay; FillPatternPlay; PolyPlay; SayGoodbye; { CloseGraph; } CloseVesa; end. *************************************************** '* SHOW D2ROTATE (ABOUT THE ORIGIN) '****************************************************************c*#^v/:j0t+l""g?%H׫׽èU'թV? ujOEZ1! B8]1GlNqݲ;$zE<c*bE#Ϥ"Lrda a^1~)@M06DFvkpؐ)}1w3ρha[THqDKY-tTЧ.*I9l{c$oFr;O2eL4^N|ثO?FOz`'<>>$6 XgoGd߰?_9Lq'Oߟn43p.O}'O?t!8/pEVoxc5ȧ$?$ZspKX9\kO_5\A[јłNu16 g,%hccDVRKR;8آs㵠xgzPMy+Ji+3 ͥӌ^Grs %#(?%u86+Q)))Afw)B&4LXV:t@.;5ftJU8ǂpvg҂عI.^vZ& 66XNE kIA+҂bt-YauuvhuSvF;p